home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / eval_az.com / EVALTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-13  |  4.1 KB  |  146 lines
  1. {---------------------------------------------------------------------
  2.  EVALUATOR UNIT TEST PROGRAM
  3.  Arthur Zatarain, P.E.        C'Serve 3417-525    Bixen=ARTZAT
  4.  Total Engineering Services Team, Inc.  (TEST Inc).
  5.  New Orleans,  La.  (504) 368-6792 Days
  6.                           837-3699 Nites
  7.  
  8.  This program demonstrates the use of the evaluator unit and the
  9.  notions of variable list objects.  This acts as a shell into the
  10.  evaluator by allocating and deallocation variable, and providing
  11.  a few demonstration functions.
  12.  
  13.  The functions that can be added into the evaluator via the virtual
  14.  method can only take single real value and return a single real.
  15.  
  16. -----------------------------------------------------------------------}
  17. program evaltest;
  18.  
  19. uses tpcrt, evaluate, testlib, printf, tpstring;
  20. const
  21.   version = 'July 13, 1989 AMZ';
  22.   max_vars = 32; { 32 variables allowed in this test}
  23. type
  24.  
  25. our_eval = object(eval_type)  { hook into the evaluator }
  26.   constructor init;
  27.   function ext_fun_search(s : small_string) : integer;  virtual;
  28.   function ext_fun_execute(i : integer; v1 : real) : real;      virtual;
  29.   procedure ext_error(s :string);          virtual;
  30. end;
  31.  
  32.  
  33. var
  34. aline : string;
  35. ablock : our_eval;
  36. a_list : a_var_list;  { object that holds variable control block for our test }
  37. ready : boolean;
  38.  
  39.  
  40. i : integer;
  41. processed : boolean;
  42. tempstr : string[40];
  43. constructor our_eval.init;
  44. begin
  45.   eval_type.init;        { init the main evaluator}
  46. end;
  47.  
  48. function our_eval.ext_fun_search(s : small_string) : integer;
  49. var
  50. j : integer;
  51. begin
  52.   j := 0;  { asssume no external function matches }
  53.   if s = 'ONE' then j := 1;
  54.   if s = 'TWO' then j := 2;
  55.   if s = 'TRREE' then j := 3;
  56.   ext_fun_search := j;
  57. end;
  58.  
  59.  
  60. { these are dummy functions do demonstrate the capabilities }
  61.  
  62. function our_eval.ext_fun_execute(i : integer; v1 : real) : real;
  63. begin
  64.   case i of
  65.     3 : ext_fun_execute := v1;
  66.     2 : ext_fun_execute := v1 * 2;
  67.     3 : ext_fun_execute := v1 * 3;
  68.   end;
  69. end;
  70.  
  71.  
  72. procedure our_eval.ext_error(s :string);
  73. begin
  74.  writeln;  blip;
  75.  writeln('EVAL ERROR: ', s);
  76. end;
  77.  
  78.  
  79. BEGIN  { main program start }
  80.   writeln;
  81.   writeln('Expression Evalulator Test');
  82.   writeln('Arthur Zatarain, P.E.');
  83.   writeln('Total Engineering Services Team, Inc.  (TEST, Inc.');
  84.   writeln('Version ',version);
  85.   writeln;
  86.  
  87.   ablock.init;  { set up the evaluator }
  88.   a_list.init(max_vars);  { set up the variable table as empty }
  89.   ablock.set_var_list(@a_list);
  90.  
  91.   with ablock, a_list do begin
  92.     ready := false;
  93.     repeat
  94.       processed := false;
  95.       Write('Enter Expression (or ?) : '); ReadLn(aline);
  96.  
  97.       if aline[1] = '$' then begin    { create a new variable }
  98.     processed := true;
  99.         ready := true;
  100.       end;  { if terminating}
  101.  
  102.       if aline[1] = '@' then begin    { create a new variable }
  103.     processed := true;
  104.     tempstr := copy(aline,2,12);
  105.     tempstr := stupcase(tempstr);
  106.     tempstr := trim(tempstr);  { clean string}
  107.     if add_name(tempstr,i) then
  108.           writeln('New Variable ',tempstr, ' at index ',i)
  109.         else
  110.          writeln('Variable creation error!');
  111.       end;  { if starting a new variable }
  112.  
  113.       if aline[1] = '#' then begin    { delete a variable }
  114.     processed := true;
  115.     tempstr := copy(aline,2,12);
  116.     tempstr := stupcase(tempstr);
  117.     tempstr := trim(tempstr);  { clean string}
  118.     delete_name(tempstr);
  119.       end;  { if deleteing variable }
  120.  
  121.       if aline[1] = '?' then begin
  122.  
  123.     processed := true;
  124.     for i := 1 to max_vars do with var_list^[i] do begin
  125.       if var_name <> '' then writeln(i, ' ',var_name,' ',var_value:1:2);
  126.     end;
  127.         writeln('@ = New Var  # = Delete Var ? = Var listing    $ = Exit');
  128.       end;
  129.  
  130.       if not processed then begin
  131.         aline := stupcase(aline);  { ALWAYS SEND IN UPPER CASE AT THIS POINT}
  132.         if do_evaluate(aline) then begin
  133.           writeln;
  134.           writeln('Result= ', eval_result:1:4)
  135.         end
  136.         else writeln('Error');
  137.       end;
  138.     until ready;
  139.   clrscr;  gotoxy(1,20);
  140.   writeln('Evaluator Test Program Normal Termination');
  141.   writeln('Y''all come back nah, y''a hear!');
  142.   end;
  143. end.
  144.  
  145.  
  146.